home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / 1svga / dirs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-20  |  7.2 KB  |  214 lines
  1. { Directory...with problem in SelectDrive }
  2.  
  3. uses Dos,Txt;
  4.  
  5. const  { Box,Title,File,Select,Dir, Mask&DriveBox,Title,Text,Selcct, }
  6.   Color:array[1..13] of byte=(    { ErrorBox,Title,Text, Messege }
  7.     $3F,$3E,$31,$5F,$34, $2F,$2E,$2E,$5F, $5F,$5E,$5E, $71);
  8. var Max,DirNum,Page,PageMax,No,K:integer;
  9.     Files:array[0..1023] of string[12];
  10.     Mask:string[12];
  11.  
  12. { ─────────────── TestDir ─────────────── }
  13. function TestDir(Path:string;DirType:byte):integer;
  14. var DirInfo:SearchRec;    { DirType: 1=File, 2=Dir, 3=Vol }
  15. begin                     { 0=Find not, 1=Yes }
  16.   FindFirst(Path,AnyFile,DirInfo); TestDir:=0;
  17.   while DosError=0 do begin
  18.     case DirType of
  19.       1:if DirInfo.Attr in [$00..$07,$20..$27] then begin TestDir:=1; Exit; end;
  20.       2:if DirInfo.Attr in [$10..$17] then begin TestDir:=1; Exit; end;
  21.       3:if DirInfo.Attr in [$08,$18,$28] then begin TestDir:=1; Exit; end;
  22.     end;
  23.     FindNext(DirInfo);
  24.   end;
  25. end;
  26. { ─────────────── SortFiles ─────────────── }
  27. procedure SortFiles(L,R:integer);
  28. var I,J:integer;
  29.     M,T:string[12];
  30. begin
  31.   I:=L; J:=R; M:=Files[(L+R) shr 1];
  32.   repeat
  33.     while Files[I]<M do Inc(I);  { Move right }
  34.     while M<Files[J] do Dec(J);  { Move left }
  35.     if I<=J then begin
  36.       T:=Files[I]; Files[I]:=Files[J]; Files[J]:=T;
  37.       Inc(I); Dec(J);
  38.     end;
  39.   until I>J;
  40.   if L<J then SortFiles(L,J);
  41.   if I<R then SortFiles(I,R);
  42. end;
  43. { ─────────────── GetFiles ─────────────── }
  44. procedure GetFiles(Path:string);
  45. var DirInfo:SearchRec;
  46. begin
  47.   Max:=0; DirNum:=0; Page:=0; No:=0;
  48.   FindFirst('*.*',AnyFile,DirInfo);
  49.   while DosError=0 do begin
  50.     if DirInfo.Attr in [$10..$17] then
  51.       begin Files[DirNum]:=DirInfo.Name; Inc(DirNum); end;
  52.     FindNext(DirInfo);
  53.   end;
  54.   Max:=DirNum;
  55.   FindFirst(Path,AnyFile,DirInfo);
  56.   while DosError=0 do begin
  57.     if DirInfo.Attr in [$00..$07,$20..$27] then
  58.       begin Files[Max]:=DirInfo.Name; Inc(Max); end;
  59.     FindNext(DirInfo);
  60.   end;
  61.   SortFiles(0,DirNum-1); SortFiles(DirNum,Max-1);
  62. end;
  63. { ─────────────── FilesMask ─────────────── }
  64. procedure FilesMask(X,Y:integer);
  65. var St:string;
  66.     I,J:integer;
  67. begin
  68.   TextWindow1(X,Y,40,3,Color[6],Color[7],1,' Enter Filenames Mask ');
  69.   TextBar(X+1,Y+1,38,1,Color[8],' ');
  70.   if (InputText(X+2,Y+1,12,St)=0) or (St='') then
  71.     begin SetCurShape($20,0); Exit; end;
  72.   SetCurShape($20,0); J:=0;
  73.   for I:=1 to Length(St) do if St[I] in [':','\'] then J:=1;
  74.   if (J=0) and (TestDir('*.*',2)=1) then begin
  75.     GetFiles(St); Mask:=St;  { 2=Dir }
  76.   end else begin
  77.     TextWindow1(X,Y,40,3,Color[10],Color[11],1,' Error ');
  78.     PrintText(X+2,Y+1,Color[12],'No such files or incorrect mask.');
  79.     K:=Key; K:=0;
  80.   end;
  81. end;
  82. { ─────────────── SelectDrive ─────────────── }
  83. procedure SelectDrive(X,Y:integer);
  84. var St:string;
  85.     I,N:integer;
  86.     D:array[0..25] of char;
  87. begin
  88.   D[0]:='A'; D[1]:='B'; N:=1;
  89.   for I:=2 to 25 do
  90.     if (TestDir(Chr(I+65)+':\*.*',1)=1) or (TestDir(Chr(I+65)+':\*.*',2)=1)
  91.     then begin Inc(N); D[N]:=Chr(I+65); end;
  92.   TextWindow1(X,Y,40,3+N div 7,Color[6],Color[7],1,' Select a Drive ');
  93.   for I:=0 to N do PrintText(X+3+5*(I mod 7),Y+1+I div 7,Color[8],D[I]+':');
  94.   I:=0;
  95.   repeat
  96.     PrintText(X+2+5*(I mod 7),Y+1+I div 7,Color[9],' '+D[I]+': ');
  97.     K:=Key;
  98.     PrintText(X+2+5*(I mod 7),Y+1+I div 7,Color[8],' '+D[I]+': ');
  99.     case K of
  100.       $4B00:Dec(I);   $4D00:Inc(I);    { Left,Right }
  101.       $4800:Dec(I,7); $5000:Inc(I,7);  { Up,Down }
  102.     end;
  103.     if I<0 then I:=N; if I>N then I:=0;
  104.   until (K=$1C0D) or (K=$011B);        { Enter,Esc }
  105.   if K=$1C0D then begin
  106.     if (TestDir(D[I]+':'+Mask,1)=1) or (TestDir(D[I]+':*.*',2)=1)
  107.     then begin
  108.       GetDir(I+1,St); ChDir(St);
  109.       GetFiles(Mask);
  110.     end else begin
  111.       TextWindow1(X,Y,40,3,Color[10],Color[11],1,' Error ');
  112.       PrintText(X+2,Y+1,Color[12],'No such files or disk not ready.');
  113.       K:=Key;
  114.     end;
  115.   end;
  116.   K:=0;
  117. end;
  118. { ─────────────── PrintFile ─────────────── }
  119. procedure PrintFile(X,Y,Color,No:integer);
  120. begin
  121.   TextBar(X,Y,14,1,Color,' ');
  122.   if No>=DirNum then PrintText(X+1,Y,Color,Files[No])
  123.     else PrintText(X+1,Y,Color,Files[No]+'\');
  124. end;
  125. { ─────────────── ShowPage ─────────────── }
  126. procedure ShowPage(X,Y,PageNo:integer);  { 4x10,56x10 }
  127. var I,C:integer;
  128. begin
  129.   PageMax:=40;
  130.   if (Max<40) or (Page=(Max-1) div 40) then PageMax:=(Max-1) mod 40+1;
  131.   for I:=0 to PageMax-1 do begin
  132.     if PageNo*40+I>=DirNum then C:=Color[3] else C:=Color[5];
  133.     PrintFile(X+14*(I and 3),Y+I shr 2,C,40*PageNo+I);
  134.   end;
  135.   for I:=PageMax to 39 do
  136.     TextBar(X+14*(I and 3),Y+I shr 2,14,1,Color[1],' ');
  137. end;
  138. { ─────────────── PrintMask ─────────────── }
  139. procedure PrintMask(X,Y,Color:integer);
  140. var St:string;
  141. begin
  142.   GetDir(0,St);
  143.   if St[Length(St)]<>'\' then St:=St+'\';
  144.   TextBar(X,Y,55,1,Color,' ');
  145.   PrintText(X,Y,Color,St+Mask);
  146. end;
  147. { ─────────────── SelectFile ─────────────── }
  148. procedure SelectFile(X,Y:integer);  { 58x13 }
  149. var C,K2:integer;
  150.     St:string;
  151.     Buf:array[0..3999] of byte;
  152. begin
  153.   if (TestDir('*.*',1)=0) and (TestDir('*.*',2)=0) then begin
  154.     Writeln('Can''t find any file or directory !'); Halt(1); end;
  155.   GetDir(0,St);
  156.   GetText(1,1,80,25,Buf);
  157.   SetCurShape($20,0);
  158.   TextBar(1,1,80,1,Color[13],' '); TextBar(1,25,80,1,Color[13],' ');
  159.   PrintText(3,1,Color[13],'Directory...Select a File');
  160.   PrintText(3,25,Color[13],'Arrows,PgUp,PgDn,Home,End,1~9,A~Z-Select'+
  161.     ' /-Mask *-Drive Enter-Do Esc-Quit');
  162.   TextWindow1(X,Y,58,13,Color[1],Color[2],1,' Select a File ');
  163.   Mask:='*.*'; GetFiles(Mask);
  164.   PrintMask(X+2,Y+1,Color[2]);
  165.   ShowPage(X+1,Y+2,0);
  166.   repeat
  167.     PrintFile(X+1+14*(No and 3),Y+2+No shr 2,Color[4],40*Page+No);
  168.     K:=Key; K2:=K mod 256;
  169.     if 40*Page+No>=DirNum then C:=Color[3] else C:=Color[5];
  170.     PrintFile(X+1+14*(No and 3),Y+2+No shr 2,C,40*Page+No);
  171.     case K of
  172.       $4B00:Dec(No);    $4D00:Inc(No);        { Left,Right }
  173.       $4800:Dec(No,4);  $5000:Inc(No,4);      { Up,Down }
  174.       $4700:No:=0;      $4F00:No:=PageMax-1;  { Home,End }
  175.       $4900:if Page>0 then                    { PgUp}
  176.           begin Dec(Page); ShowPage(X+1,Y+2,Page); end;
  177.       $5100:if Page<(Max-1) div 40 then       { PgDn }
  178.           begin Inc(Page); ShowPage(X+1,Y+2,Page); end;
  179.       $352F:begin                             { / }
  180.           FilesMask(X+8,Y+5);
  181.           PrintMask(X+2,Y+1,Color[2]);
  182.           ShowPage(X+1,Y+2,Page);
  183.         end;
  184.       $372A,$092A:begin                       { * }
  185.           SelectDrive(X+8,Y+5);
  186.           PrintMask(X+2,Y+1,Color[2]);
  187.           ShowPage(X+1,Y+2,Page);
  188.         end;
  189.       $1C0D:if 40*Page+No<DirNum then begin   { Enter }
  190.           ChDir(Files[40*Page+No]);
  191.           GetFiles(Mask);
  192.           PrintMask(X+2,Y+1,Color[2]);
  193.           ShowPage(X+1,Y+2,Page);
  194.         end;
  195.     end;
  196.     if K2 in [48..57,65..90,97..122] then begin  { 0..9, A..Z, a..Z }
  197.       if K2>=97 then Dec(K2,32);
  198.       for C:=DirNum to Max-1 do if Files[C,1]=Chr(K2) then begin
  199.     Page:=C div 40; ShowPage(X+1,Y+2,Page);
  200.     No:=C mod 40; C:=Max-1;
  201.       end;
  202.     end;
  203.     if No<0 then No:=PageMax-1;
  204.     if No>PageMax-1 then No:=0;
  205.   until K=$011B;                              { Esc }
  206.   PutText(1,1,80,25,Buf);
  207.   ChDir(St);
  208. end;
  209.  
  210. begin
  211.   SelectFile(12,6);
  212.   VideoMode(3);
  213. end.
  214.